perm filename CONNEW.F4[MUS,LCS] blob
sn#075950 filedate 1974-01-08 generic text, type T, neo UTF8
00100 C *******CONVERTS FROM MAGTAPE OR 2314 TO UDP OR 2314 ***********
00200 C DEC 17,1970 ********* CONVERTS 18 (AND 12) BIT .DMD FILES ***********
00300 C CONVERTS .DMD FILES WRITTEN WITH RCDFLG←1; OR BIGBIT←1;(or ←2;)
00400 C LOAD WITH FSTUDP.REL AND NORM.REL. (PUTFIL,FASTOU,FINFIL IN FORT.LIB)
00500 C TYPE 'X' IF FINAL NAME UNKNOWN OR IF DATA GOES BEYOND CURRENT TAPE.
00600 C 1ST NAME OF EACH PAIR TYPED BY COMPUTER IS BASED ON NAME #1 YOU TYPED.
00700 C 2ND IS ACTUAL NAME OF FILE.
00800 C IF NO MAXAMP IS TYPED AFTER NAME #1, IT WILL BE REQUESTED LATER.
00900 C TO BACK UP TYPE '-1'. 'REWIND' MAY BE TYPED AFTER 'MTA0' OR 'NAME #1'.
01000 C USE 'TAPMUS' TO ADVANCE TAPE IF NEEDED.
01100 DIMENSION JSB(128),IBOTT(8000)
01200 150 FORMAT(' WRITE ON UDP?'/)
01300 100 FORMAT(' TYPE NAME #1'/)
01400 200 FORMAT(' TYPE FINAL NAME'/)
01500 250 FORMAT(A1)
01600 300 FORMAT(2XA5,I6,I9)
01700 350 FORMAT(' ASSIGN THE UDP!!'/)
01800 400 FORMAT(A5,2I)
01900 450 FORMAT(' READ FROM MTA0?'/)
02000 500 FORMAT(I,' WORDS, FACTOR=',F6.3,', MAXAMP=',I4/)
02100 600 FORMAT(' MORE??'/)
02200 700 FORMAT(' TYPE MAXAMP'/)
02300 800 FORMAT(4I)
02400 EQUIVALENCE (JSB(2),JSB2),(JSB(3),JSB3),(JSB(4),JSB4)
02500 MUSIC='MUSIC'
02600 TYPE 150
02700 ACCEPT 250,UDP
02800 IF(UDP.EQ.'X')GO TO 440
02900 C TYPE 'X' TO PASS DSK INITS.
03000 IF(UDP.NE.'Y')CALL PUTMUS(MUSIC)
03100 FACTOR=1.
03200 ISIZE=9000
03300 N=ISIZE
03400 JUDP=4
03500 C GARPLY READS 4*1024 WDS.
03600 JSIZE=1024
03700 IF(UDP.NE.'Y')GO TO 101
03800 TYPE 350
03900 CALL INTUDP
04000 C********* CHANGE NEXT NUMBER IF PROBLEMS WITH 3330 DISK **************
04100 JSIZE=128*18+32
04200 JUDP=7
04300 C UDPNEW READS 7*1312 WDS. ***** FOR 2314 DSK **************
04400 101 KSIZE=JSIZE
04500 MX=0
04600 KCNT=0
04700 IX=0
04800 JA=1
04900 440 TYPE 450
05000 ACCEPT 250,TAPE
05100 IF(TAPE.NE.'R')GO TO 54
05200 REWIND 16
05300 TAPE='Y'
05400 54 TYPE 100
05500 JNM='AAAAA'
05600 ACCEPT 400,NAME,MAXAMP
05700 IF(MAXAMP.EQ.0)MAXAMP=MX
05800 IF(NAME.EQ.'-1')GO TO 440
05900 IF(NAME.EQ.'NO')GO TO 1201
06000 C CAN TYPE 'NO' IF MISTAKE EARLIER.
06100 IF(NAME.EQ.' ')NAME='MUSAA'
06200 2 JNM=JNM+((NAME-JNM)/256*256)
06300 KNM=JNM
06400 C AUTOMATICALLY SETS BASIC NAME TO 'A' ENDING. 12-BIT SOUND NOT NORMALIZED.
06500 1002 TYPE 200
06600 ACCEPT 400,NM2,KSKIP
06700 IF(NM2.EQ.'-1')GO TO 54
06800 IF(NM2.EQ.' ')NM2=NAME
06900 IF(TAPE.NE.'Y')GO TO 7077
07000 IF(MAXAMP.NE.0)GO TO 2710
07100 TYPE 700
07200 ACCEPT 800,MAXAMP
07300 IF(MAXAMP)GO TO 54
07400 IX=0
07500 2710 IF(NM2.EQ.' ')NM2=NAME
07600 1710 CALL GETTAP
07700 1810 CALL INTAPE(JSB(1),128)
07800 IF(JSB(1))GO TO 1202
07900 TYPE 300,JSB3
08000 IF(IX.OR.JSB2.EQ.3)GO TO 2022
08100 IF(MAXAMP.EQ.0)MAXAMP=2040
08200 GO TO 199
08300 7077 IF(MAXAMP.NE.0)GO TO 4022
08400 CALL GETFIL(NM2)
08500 CALL FASTIN(JSB(1),128)
08600 IF(JSB2.EQ.3)GO TO 4022
08700 JSC=JSB(1)
08800 6066 CALL FASTIN(IBOTT(1),JSC)
08900 IF(IBOTT(JSC).EQ.0)GO TO 6066
09000 MAXAMP=IABS(IBOTT(JSC))
09100 4022 IF(N)GO TO 710
09200 N=-2
09300 IF(JSB2.EQ.3)GO TO 710
09400 199 FACTOR=2040./MAXAMP
09500 MX=MAXAMP
09600 IX=-1
09700 KSIZE=3*JSIZE/2
09800 IF(TAPE.EQ.'Y')GO TO 2022
09900 C AMPL. WILL BE NEG. IF LSBUF WAS NOT FULL (LAST BUFFER).
10000 710 IF(TAPE.EQ.'Y')GO TO 1810
10100 CALL GETFIL(NAME)
10200 810 CALL FASTIN(JSB(1),128)
10300 IF(JSB2.EQ.3)IX=0
10400 2022 JSC=JSB(1)
10500 1022 IF(JA.GT.KSIZE)GO TO 17
10600 610 IF(TAPE.NE.'Y')CALL FASTIN(IBOTT(JA),JSC)
10700 IF(TAPE.EQ.'Y')CALL INTAPE(IBOTT(JA),JSC)
10800 C LAST WORD IS THROWN AWAY.
10900 JA=JA+JSC-1
11000 JC=IBOTT(JA)
11100 IF(JC)5,1022,6
11200 5 JA=JA-IBOTT(JA-1)
11300 6 TYPE 300,NAME,JC,KCNT
11400 NAME=NAME+2
11500 IF(NAME.LE.JNM+50)GO TO 27
11600 JNM=JNM+256
11700 IF(JNM.LE.KNM+6400)GO TO 1017
11800 KNM=JNM+26112
11900 JNM=KNM
12000 C RAISES 'AAAZA' TO 'AABAA'
12100 1017 NAME=JNM
12200 27 IF(NAME.LE.NM2)GO TO 710
12300 1202 TYPE 600
12400 ACCEPT 400,NAME
12500 IF(NAME.EQ.'YES'.OR.NAME.EQ.'Y')GO TO 440
12600 1201 NM2=NAME-1
12700 17 JC=JA-1
12800 IF(JC.LT.KSIZE)GO TO 23
12900 10 IF(IX)CALL NORM(IBOTT(1),KSIZE,FACTOR)
13000 LSIZE=KSIZE
13100 JMP=-1
13200 32 KCNT=KCNT+JSIZE
13300 IF(UDP.EQ.'Y')GO TO 132
13400 CALL FSTMUS(IBOTT(1),JSIZE)
13500 IF(JMP)7,8,9
13600 132 CALL TOUDP(IBOTT(1),JSIZE)
13700 IF(JMP)7,8,9
13800 7 JC=JC-LSIZE
13900 DO 12 K=1,JC
14000 12 IBOTT(K)=IBOTT(K+LSIZE)
14100 JA=JC+1
14200 IF(JC.GT.KSIZE)GO TO 10
14300 IF(NAME.LE.NM2)GO TO 610
14400 23 IF(IX.EQ.0)GO TO 43
14500 CALL NORM(IBOTT(1),JC,FACTOR)
14600 JC=JC*2/3
14700 43 DO 13 K=JC+1,JSIZE
14800 13 IBOTT(K)=0
14900 JMP=0
15000 GO TO 32
15100 8 DO 14 K=1,JSIZE
15200 14 IBOTT(K)=0
15300 JMP=1
15400 GO TO 32
15500 9 K=KCNT/JSIZE
15600 L=K-(K/JUDP)*JUDP
15700 IF(L.EQ.0)GO TO 3222
15800 DO 4222 K=1,JSIZE
15900 4222 IBOTT(K)=0
16000 DO 5222 K=1,L
16100 IF(UDP.NE.'Y')GO TO 6222
16200 CALL TOUDP(IBOTT(1),JSIZE)
16300 GO TO 5222
16400 6222 CALL FSTMUS(IBOTT(1),JSIZE)
16500 5222 CONTINUE
16600 KCNT=KCNT+L*JSIZE
16700 3222 IF(UDP.NE.'Y')CALL FINMUS
16800 IF(UDP.EQ.'Y')CALL FINUDP(KCNT)
16900 7222 TYPE 500,KCNT,FACTOR,MAXAMP
17000 END